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-- file Pass3D.Mesa 

-- last modified by Satterthwaite, August 2, 1978 12:10 PM 

DIRECTORY 

ComData: FROM "comdata" 
USING [ 

bodylndex, idANY, idCARDINAL, mainBody, mainCtx, seAnon, textlndex, 
typelNTEGER. typeSTRING, xref], 
CopierDefs: FROM "copierdefs" 
USING [ 

CopyUnion, CreateFileTable. EnterFile, FillModule, LocateTables , 
UnknownModule] , 
ErrorDefs: FROM "errordefs" USING [error, errorhti, errorsei, errortree], 
P3Defs: FROM "pSdefs" 
USING [ 

CircuitCheck. CircuitSignal , PSMark, 

CheckDisjoint, CompleteRecord , Exp, FindSe, GetDirectorylds. 
PopCtx, PushCtx, RConst, RecordReference, ReplaceCtx,' Rhs, RPop, RType. 
SearchCtxList, TopCtx, TreeStringVal ue, 
Ambiguous Identifier , Undeclaredldentifier], 
SymboUableDefs: FROM "symboUabledef s" 

USING [SetSymbolCacheSize, SymbolCacheSize] , 
SymDefs: FROM "symdefs" 

USING [setype, ctxtype, mdtype, bodytype, 
SERecord, CTXRecord. BodyRecord, 

HTIndex. SEIndex, ISEIndex, CSEIndex, recordCSEIndex, 
CTXIndex, includedCTXIndex, BTIndex, CBTIndex, 
HTNull. SENull, ISENun. CTXNull . BTNull , CBTNull . 
codelNTEGER. typeANY, typeTYPE], 
SymTabDefs: FROM "symtabdefs" 
USING [ 

CtxEntries, makenonctxse, NextSe, NormalType, TransferTypes , TypeForm, 
UnderType, XferMode], 
TableOefs: FROM "tabledefs" USING [TableBase. TableNotif ier , Allocate, TableBounds], 
TreeOefs: FROM "treedefs" 
USING [treetype. 

Treelndex. TreeLink, TreeMap, TreeScan, 

empty, nullTreelndex, 

GetNode, listlength, scanlist, testtree, updatelist]; 

PassSD: PROGRAM 
IMPORTS 

CopierDefs, ErrorDefs, PSDefs, 

SymbolTableDefs, SymTabDefs, TableDefs, TreeOefs, 
dataPtr: ComData 
EXPORTS PSDefs « 
BEGIN 
OPEN TreeDefs, SymTabDefs, SymDefs, PSDefs; 

tb: TableDefs. TableBase; -- tree base address (local copy) 

seb: TableDefs. TableBase; -- se table base address (local copy) 

ctxb: TableDefs. TableBase; -- context table base address (local copy) 

mdb: TableDefs .TableBase; -- mo-dule table base address (local copy) 

bb: TableDefs. TableBase; -- body table base address (local copy) 

DeclNotify: PUBLIC TableDefs .TableNotif ier = 

BEGIN -- called by allocator whenever table area is repacked 

tb <- base[treetype]; 

seb *- base[setype]; ctxb <- base[ctxtype]; mdb <~ base[mdtype]; 

bb <- base[bodytype]; RETURN 

END; 

-- signals for loop detection 

CheckTypeLoop: PUBLIC CircuitCheck = CODE; 
LogTypeLoop: PUBLIC CircuitSignal « CODE; 

CheckExprLoop: PUBLIC CircuitCheck « CODE; 
LogExprLoop: PUBLIC CircuitSignal » CODE; 

-- declaration processing 

Declltem: PUBLIC TreeScan « 
BEGIN 
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node: Treelndex « GetNode[t]; 

expNode: Treelndex; 

type: SEIndex; 

eqFlag, constFlag: BOOLEAN; 

v: WORD; 

Explnit: PROCEDURE [t: TreeLink, type: SEIndex] RETURNS [val : TreeLink] « 
BEGIN 

val <- Rhs[t, TargetType[UnderType[type]]]; 
constFlag <- eqFlag AND RConst[]; RPop[]; 
V <- 1; RETURN 
END; 

savelndex: CARDINAL ■ dataPtr. textlndex; 
BEGIN 
ENABLE 
BEGIN 

CheckTypeLoop, CheckExprLoop => IF loopNode=node THEN RESUME [TRUE]; 
LogTypeLoop, LogExprLoop => IF loopNode=node THEN RESUME 
END; 
IF (tb+node) .mark » P3Mark THEN RETURN; -- already processed 
(tb+node) .mark ♦- P3Mark; 
dataPtr. textlndex ♦- (tb+node) . info; 

IF dataPtr. xref THEN scan! ist[(tb+node) .sonl, Recordld]; 
IF testtree[(tb+node) .son2. modeTC] 
THEN 

BEGIN OPEN (tb+node); 
son3 <- TypeExp[son3]; type <- typeTYPE; 
Def ineTypeSe[sonl, TypeForTree[son3]]; 
END 
ELSE 

BEGIN OPEN (tb+node); 

son2 ^ TypeExp[son2]; type <- TypeForTree[son2]; 

IF son3 = empty 

THEN BEGIN eqFlag ♦- constFlag ^ FALSE; v ♦- END 
ELSE 
BEGIN 

IF dataPtr. xref THEN scanl ist[sonl , RecordLhs]; 
eqFlag ♦- attrl; 
WITH son3 SELECT FROM 
subtree »> 

BEGIN expNode ♦- index; 
SELECT (tb+expNode).name FROM 
body »> 

BEGIN -- defer processing of bodies (see Body) 
SELECT XferMode[type] FROM 
procedure, program => NULL; 
ENDCASE => 

IF TypeForm[type] # definition 
THEN ErrorDef s . error[bodyType] ; 
V *- IF (constFlag *- eqFlag) THEN ELSE 1; 
END; 
inline »> 
BEGIN 
IF XferMode[type] # procedure OR -eqFlag 

THEN ErrorDef s .error[inl ineType]; 
(tb+expNode) .sonl ♦- 

updatel ist[(tb+expNode) .sonl, Inl ineOp]; 
constFlag <- eqFlag; v *- 0; 
END; 
apply => 

IF (tb+expNode) .sonl If empty 
OR UnderType[type] # dataPtr . typeSTRING 
OR listlength[(tb+expNode).son2] # 1 
THEN sons <- ExpIni t[son3 , type] 
ELSE 

BEGIN (tb+expNode) .name +- stringinit; 
(tb+expNode) .info <- dataPtr . typeSTRING; 
(tb+expNode) .son2 <- Rhs[ 

(tb+expNode) .son2, dataPtr .typelNTEGER]; 
IF ~RConst[] 

THEN ErrorDef s .errortree[ 

nonConstant, ( tb+expNode) . son2]; 
RPop[]; constFlag <- FALSE; v *- 1; 
END; 
signalinit «> v ♦- IF (constFlag^eqFlag) THEN ELSE 1; 
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ENDCASE °> son3 <- Expini t[son3 , type]; 
END; 
ENDCASE "> sons <- ExpInit[son3 , type]; 
END; 
Def ineSe[(tb+node) .sonl, type, eqFlag, constFlag, v]; 
END; 
END; 
dataPtr.textlndex ♦- savelndex; RETURN 
END; 

InlineOp: TreeMap ■ 
BEGIN 

EvalConst: TreeMap ■ 
BEGIN 

V 4- Rhs[t. dataPtr.typelNTEGER]; 

IF '-RConstC] THEN ErrorDef s .errortree[nonConstant, v]; 
RPop[]; RETURN 
END; 

RETURN [update1ist[t, EvalConst]] 
END; 

RecordId: TreeScan ■ 
BEGIN 
WITH t SELECT FROM 

symbol -> RecordReference[index, declaration]; 

ENDCASE; 
RETURN 
END; 

RecordLhs: TreeScan = 
BEGIN 
WITH t SELECT FROM 

symbol «> RecordReference[index, Ihs]; 

ENDCASE; 
RETURN 
END; 

DefineSe: PROCEDURE [t: TreeLink, type: SEIndex. fixed, constant: BOOLEAN, info: WORD] 
BEGIN 

UpdateSe: TreeScan « 
BEGIN 

sei : ISEIndex; 
WITH t SELECT FROM 
symbol «> 

BEGIN sei <- index; 
(seb+sei) . idtype «- type; 

(seb+sei) .mark3 *- TRUE; (seb+sei) .writeonce ^ fixed; 
(seb+sei) .constant <- constant; (seb+sei) . idinfo *- info; 
END; 
ENDCASE => ERROR; 
RETURN 
END; 

scanlist[t, UpdateSe]; RETURN 
END; 

DefineTypeSe: PROCEDURE [t: TreeLink, info: SEIndex] » 
BEGIN 
first: BOOLEAN ^ TRUE; 

UpdateSe: TreeScan ■ 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol «> 

BEGIN sei *• index; 

(seb+sei) . idtype <- typeTYPE; (seb+sei ) .markS <- TRUE; 
(seb+sei) .writeonce ^ (seb+sei ) .constant *- TRUE; 
(seb+sei) . idinfo <- info; 
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IF first THEN BEGIN info ^ sei; first <- FALSE END; 

END; 
ENDCASE -> ERROR; 
RETURN 
END; 

scanlist[t, UpdateSe]; RETURN 
END; 

BumpCount: PUBLIC PROCEDURE [sei: ISEIndex] - 
BEGIN OPEN (seb+sei); 
IF idtype # typeTYPE AND 
mark3 AND ('-mark4 OR (ctxb+ctxnum) .ctxType = imported) 

THEN idinfo ^ idinfo + 1; 
RETURN 
END; 

Resolveld: PROCEDURE [hti: HTIndex. ctx: CTXIndex] RETURNS [sei: ISEIndex] 
BEGIN 

currentCtx: CTXIndex = TopCtx[]; 
IF ctx = currentCtx 

THEN sei <- FindSe[hti] . symbol 
ELSE 

BEGIN PopCtx[]; 

sei <- Resol veld[hti , ctx]; PushCtx[currentCtx]; 
END; 
RETURN 
END; 

ResolveReference: PUBLIC PROCEDURE [sei: ISEIndex] = 
BEGIN 

currentCtx: CTXIndex « TopCtx[]; 
IF (seb+sei) .ctxnum = currentCtx 

THEN Dec! Item[TreeLink[subtree[index: (seb+sei) . idvalue]]] 
ELSE 

BEGIN PopCtx[]; 

Resol veReference[ sei]; Pus hCtx[ currentCtx]; 
END; 
RETURN 
END; 

-- include module processing 

DirectoryScan: PUBLIC PROCEDURE [t: TreeLink] RETURNS [nLists: CARDINAL] = 
BEGIN 

FileEntry: TreeScan » 
BEGIN 

node: Treelndex = GetNode[t]; 
hti: HTIndex; 

hti <- CopierDefs.EnterFile[TreeStringValue[(tb+node) .son2]]; 
(tb+node) . son2 ♦- TreeLink[hash[index : hti]]; 
IF (tb+node) .son3 ff empty THEN nLists <- nLists+1; 
RETURN 
END; 

n: CARDINAL = 1 istlength[t] ; 
nLists ♦- 0; 

CopierDefs.CreateFileTable[n]; 
IF n jy 

THEN BEGIN scanlist[t, FileEntry]; CopierDefs . LocateTables[n] END; 
RETURN 
END; 

Directoryltem: PUBLIC TreeScan » 
BEGIN 

node: Treelndex = GetNode[t]; 
savelndex: CARDINAL = dataPtr. textlndex; 
saveSize: CARDINAL « Symbol TableDefs .SymbolCacheSize[] ; 
dataPtr . textlndex <- ( tb+node) . info; 
-- clear the symbol cache 

Symbol Tab leDefs.SetSymbol Caches ize[0]; 
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Symbol Tab leDefs.SetSymbol Caches ize[ 256]; 
IF dataPtr.xref THEN RecorclId[(tb+node) . sonl] ; 
WITH id: (tb+node) . sonl SELECT FROM 
symbol ■> 
BEGIN 
WITH (tb+node). son2 SELECT FROM 

hash »> CopierDefs.FinModule[id. index, index 
ICopierDefs.UnknownModule «> 
BEGIN ErrorDefs.errorhti[moduleId. hti]; RESUME END]; 
ENDCASE «> ERROR; 
GetDirectoryIds[t]; 
END; 
ENDCASE «> ERROR; 
-- restore symbol caching 

Symbol Tab leDefs.SetSymbol Caches ize[s a veSize];' 
dataPtr.textlndex ♦- savelndex; RETURN 
END; 

Importltem: PUBLIC TreeScan - 
BEGIN 

node: Treelndex = GetNode[t]; 
type, vType: CSEIndex; 
ctx: CTXIndex; 

includedCtx: includedCTXIndex; 
const: BOOLEAN; 

savelndex: CARDINAL « dataPtr.textlndex; 
dataPtr.textlndex ^ (tb+node) . info; 
IF dataPtr.xref THEN RecordId[( tb+node) .sonl] ; 
(tb+node) .son2 ♦- Exp[(tb+node) .son2, typeANY]; 
vType «- RType[]; const <- RConst[]; RPop[]; 
WITH v: (seb+vType) SELECT FROM 
definition => 

WITH c: (ctxb+v.defCtx) SELECT FROM 
included «> 
BEGIN 

includedCtx ♦- LOOPHOLE[v.defCtx]; 

ctx <- TableDefs.Anocate[ctxtype, SIZE[imported CTXRecord]]; 
(ctxb+ctx)t 4- CTXRecord[ 

sn: snNil . 
selist: ISENull, 
ctxlevel : c.ctxlevel , 

extension: imported[includeLink: includedCtx]]; 
type <- makenonctxse[SIZE[def inition constructor SERecord]]; 
(seb+type)t *- SERecord[mark3: TRUE, mark4: TRUE, 
sebody: constructor[def inition[ 
nGfi: v.nGfi, 
defCtx: ctx]]]; 
IF ~(tb+node).attrl 

THEN ReplaceCtx[old: includedCtx, new: ctx]; 
END; 
ENDCASE =»> 

BEGIN type ♦- typeANY; 

ErrorDefs .errortree[not Port able, (tb+node) . son2]; 
END; 
transfer => 
BEGIN 
IF v.mode # program 

THEN ErrorDefs .errortree[notPortable, (tb+node) .son2]; 
WITH (tb+node). sonl SELECT FROM 

symbol => (seb+index) .writeonce <- TRUE; 
ENDCASE *> ERROR; 
type <- MakePointerType[MakeFrameRecord[( tb+node) .son2] , typeANY]; 
const <r FALSE; 
END; 
ENDCASE «> 
BEGIN 
IF vType ^ typeANY 

THEN ErrorDefs. errortree[typeClash, (tb+node) , son2]; 
type <- typeANY; 
END; 
Def ineSe[(tb+node) .sonl, type, TRUE, const, 0]; 
dataPtr.textlndex <- savelndex; RETURN 
END; 

Exportid: PUBLIC TreeMap » 
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BEGIN 

type: CSEIndex; 

saveXref: BOOLEAN » dataPtr .xref ; 
dataPtr.xref <- FALSE; 

V ♦- Exp[t, typeANY]; type <- RType[]; RPop[]; 
WITH d: (seb+type) SELECT FROM 
definition ■> 
BEGIN 
WITH (ctxb+d.defCtx) SELECT FROM 

included «> (mdb+ctxmodule) .mdExported ♦- TRUE; 
ENDCASE »> ErrorDefs.errortree[notPortable, v]; 
END; 
ENDCASE «> 
BEGIN 

IF type # typeANY THEN ErrorDefs.errortree[typeC1ash, v]; 
type <- typeANY; 
END; 
dataPtr.xref ^ saveXref; RETURN 
END; 



CheckTypeld: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] ■ 
BEGIN 

node: Treelndex; 

IF (seb+sei).mark3 THEN RETURN [(seb+sei) . idtype « typeTYPE]; 
node <r (seb+sei) . idvalue; 

RETURN [node = nullTreelndex OR testtree[(tb+node) . son2 , modeTC]] 
END; 

TypeSymbol: PROCEDURE [sei: ISEIndex] RETURNS [val : TreeLink] « 
BEGIN 

declNode: Treelndex; 
savelndex: CARDINAL; 

entrylndex: CARDINAL = dataPtr . textlndex; 
IF -(seb+sei) .mark3 
THEN 
BEGIN 
ENABLE 

LogTypeLoop »> 

BEGIN savelndex ♦- dataPtr . textlndex; 
dataPtr, textlndex *- entrylndex; 
ErrorDefs .error sei [circular Type, sei]; 
dataPtr. textlndex ♦- savelndex; 
END; 
declNode ^ (seb+sei) . idvalue; 
IF (tb+declNode).mark # PSMark 
THEN Resol veReference[sei] 
ELSE 

IF SIGNAL CheckTypeLoop[dec1Node] 
THEN SIGNAL LogTypeLoop[dec1Node] ; 
END; 
IF CheckTypeId[sei] 

THEN val *- TreeLink[symbol[index: sei]] 
ELSE 
BEGIN 

ErrorDefs .errorsei[nonTypeId, sei] ; 
val ♦- TreeLink[syfnbo1[index : dataPtr. idANY]]; 
END; 
IF dataPtr.xref THEN RecordReference[sei , mention]; 
RETURN 
END; 



PushArgCtx: PUBLIC PROCEDURE [sei: recordCSEIndex] » 
BEGIN 

IF sei # SENun THEN PushCtx[(seb+sei ) .f ieldctx] ; RETURN 
END; 

PopArgCtx: PUBLIC PROCEDURE [sei: recordCSEIndex] ■ 
BEGIN 

IF sei ff SENun THEN PopCtx[]; RETURN 
END; 



TypeExp: PUBLIC PROCEDURE [typeExp: TreeLink] RETURNS [val: TreeLink] 
BEGIN 
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iSei: ISEIndex; 
WITH typeExp SELECT FROM 
hash ■> 
BEGIN 

[symbol: iSei] ♦- FindSe[ind8x 
lUndeclaredldentif ier »> 
BEGIN 

IF hti f^ HTNull THEN ErrorDef s .errorhti[unknownId , hti]; 
RESUME [dataPtr.idANY] 
END; 
Ambiguousldentif ier ■> 
BEGIN 

ErrorDef s .errorhti[ambiguousId. (seb+sei).htptr]; 
RESUME [dataPtr.idANY] 
END]; 
val <- TypeSymbol[iSei]; 
END; 
symbol ■> val ♦- TypeSymbo1[index]; 
subtree «> 
BEGIN 

node: Treelndex « index; 
SELECT (tb+node) .name FROM 
discrimTC »> 

BEGIN OPEN (tb+node); 
sonl ^ TypeExp[sonl]; 
WITH son2 SELECT FROM 
hash => 

iSei ^ Se1ectVariantType[ConsType[TypeForTree[sonl]], index]; 
ENDCASE => ERROR; 
info ♦- iSei; son2 <- TreeLink[symbol [index: iSei]]; 
END; 
dot «> 

BEGIN OPEN (tb+node): 
found: BOOLEAN; 
nDerefs: CARDINAL; 
sei: SEIndex; 
subType: CSEIndex; 
ctx: CTXIndex; 
sonl ♦- Exp[sonl, typeANY]; 
subType *- RType[]; RPop[]; 
WITH son2 SELECT FROM 
hash »> 
BEGIN 

nDerefs ♦- 0; 
DO 

WITH t: (seb+subType) SELECT FROM 
definition «> 

BEGIN ctx <- t.defCtx; GO TO search END; 
record »> 

BEGIN ctx ^ t.fieldctx; GO TO search END; 
pointer »> 
BEGIN 

IF (nDerefs <- nDerefs+1) > 255 THEN GO TO fail; 
t. dereferenced <- TRUE; sei ♦- t.pointedtotype; 
END; 
long => sei <- t.rangetype; 
subrange => sei <- t.rangetype; 
ENDCASE => GO TO fail ; 
subType <- ConsType[sei]; 
REPEAT 

fail «> found <- FALSE; 
search «> 

[founds iSei] ^ SearchCtxList[index, ctx]; 
ENDLOOP; 
IF -found 
THEN 

BEGIN iSei <- dataPtr.idANY; 
ErrorDef s .errorhti[unknownField, index]; 
END; 
name <- cdot; info <- iSei; son2 «- TypeSymbol[iSe1]; 
END; 
ENDCASE «> ERROR; 
END; 
frameTC »> 

BEGIN OPEN (tb+node); 

sonl *- Exp[sonl, typeANY]; RPop[]; 
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info ^ MakeFrameRecord[sonl]; 
END; 
ENDCASE -> 

BEGIN OPEN (tb+node); 
subType: SEIndex; 
consType: CSEIndex; 
sei: CSEIndex ■ info; 
WITH (seb+sei) SELECT FROM 

enumerated ■> IF dataPtr.xref THEN scan! ist[sonl , Recordid]; 
record ■> 
BEGIN 

PushCtx[f ieldctx]; scan! ist[sonl, Declltem]; 
PopCtx[]; 
END; 
pointer -> 
BEGIN 

sonl ^ TypeExp[sonl ICheckTypeLoop -> RESUME[FALSE]] ; 
pointedtotype ^ TypeForTree[sonl]; 
END; 
array ■> 
BEGIN 
IF sonl » empty 

THEN subType ^ dataPtr . idCARDINAL 
ELSE 
BEGIN 

sonl <- TypeExp[sonl]; subType *- TypeForTree[sonl] ; 
IF '-OrderedType[subType] 
THEN 

BEGIN subType <- typeANY; 
ErrorDefs .error[nonOrderedType]; 
END; 
END; 
indextype <- subType; 

son2 <- TypeExp[son2] ; componenttype ^ TypeForTree[son2]; 
END; 
arraydesc «> 
BEGIN 

sonl <- TypeExp[sonl ICheckTypeLoop »> RESUME[FALSE]]; 
describedType <- TypeForTree[sonl]; 
IF TypeForm[describedType] array 
THEN ErrorDefs .error[descriptor]; 
END; 
transfer «> 
BEGIN 

ENABLE CheckTypeLoop => RESUME[FALSE] ; 
IF inrecord # SENull AND outrecord # SENull 
THEN CheckDisjoint[ 

(seb+inrecord).fie1dctx» (seb+out record) .f ieldctx]; 
PushArgCtx[inrecord] ; scan! ist[sonl , Declltem]; 
PushArgCtx[outrecord] ; scan! ist[son2 , Declltem]; 
PopArgCtx[outrecord] ; PopArgCtxf inrecord]; 
END; 
definition «> defCtx *- dataPtr.mainCtx; 
union «> 
BEGIN 

tagType: CSEIndex; 
Dec1 Item[sonl]; 

(seb+tagsei) .writeonce ^ TRUE; 
tagType ^ ConsType[(seb+tagsei ) . idtype]; 
DO 

WITH (seb+tagType) SELECT FROM 
enumerated => EXIT; 

subrange => tagType ^ ConsType[rangetype]; 
ENDCASE «> 

BEGIN ErrorDefs .errorsei[nonTagType , tagsei]; 
tagType ♦- typeANY; EXIT 
END; 
ENDLOOP; 
VariantList[son2, tagType]; 
END; 
relative «> 
BEGIN 

vType: CSEIndex; 

sonl <- TypeExp[sonl] ; baseType ♦- TypeForTree[sonl]; 
IF (seb+Norma1Type[ConsType[baseType]]) . typetag # pointer 
THEN Error Defs.error[re1ative]; 



Pass3D.mesa 2-Sep-78 12:59:59 Page 



son2 <- TypeExp[son2]; offsetType ♦- TypeForTr0e[son2] ; 
vType ♦- ConsType[offsetType]; consType <- NormalType[vType]; 
SELECT (seb+consType).typetag FROM 
pointer, arraydesc «> NULL; 
ENDCASE => 
BEGIN 

ErrorDefs.error[re1ative]; consType ♦■ typeANY; 
END; 
IF (seb+ConsType[baseType]) . typetag » long 
OR (seb+vType) .typetag « long 

THEN consType <- MakeLongType[consTyp0,ConsType[off setType]] ; 
resultType ^ consType; 
END; 
subrange •»> 
BEGIN 

sonl <- TypeExp[sonl] ; subType ♦- TypeForTree[sonl]; 
rangetype *■ subType; consType ^ ConsType[subType3; 
SELECT TRUE FROM 

(TypeForm[consType] » pointer) »> 

Interval[son2, dataPtr. typelNTEGER, TRUE]; 
OrderedType[consType] => 

Interva1[son2, consType, TRUE]; 
ENDCASE => 

BEGIN ErrorDef s .error[nonOrderedType]; 
Interva1[son2. typeANY, TRUE]; 
END; 
END; 
long => 
BEGIN 

sonl <- TypeExp[sonl] ; subType <- TypeForTree[sonl]; 
rangetype <- subType; consType ^ ConsType[subType]; 
WITH (seb+consType) SELECT FROM 
pointer, arraydesc => NULL; 

basic => IF code ft codelNTEGER THEN ErrorDef s .error[long] ; 
ENDCASE => ErrorDefs.error[long]; 
END; 
ENDCASE => ERROR; 
(seb+sei) .marks «- TRUE; 
END; 
val ♦- typeExp; 
END; 
ENDCASE => ERROR; 
RETURN 
END; 

VariantList: PROCEDURE [t: TreeLink. tagType: CSEIndex] » 
BEGIN 

DefineTag: TreeScan = 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol => 

BEGIN sei ♦- index; 

(seb+sei ) . idvalue ♦- TagValue[(seb+sei) .htptr , tagType]; 
END; 
ENDCASE »> ERROR; 
RETURN 
END; 

Variant I tern: TreeScan « 
BEGIN 

node: Treelndex » GetNode[t]; 
savelndex: CARDINAL = dataPtr . textlndex; 
Declltem[t]; 

dataPtr. textlndex <- (tb+node) . info; 
scan]ist[( tb+node) . sonl , DefineTag]; 
dataPtr, textlndex <- savelndex; RETURN 
END; 

scanlist[t, Variantltem]; 

RETURN 

END; 

TagValue: PROCEDURE [tag: HTIndex, tagType: CSEIndex] RETURNS [CARDINAL] - 
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BEGIN 

matched: BOOLEAN; 
sei: ISEIndex; 

WITH (seb+tagType) SELECT FROM 
enumerated «> 

BEGIN 

[matched, sei] <- SearchCtxList[tag, valuectx]; 

IF matched THEN RETURN [(seb+sei) . idvalue]; 

END; 
ENDCASE; 
ErrorDefs.errorhti[unknownTag, tag]; RETURN [0] 
END; 

SelectVariantType: PROCEDURE [type: CSEIndex, tag: HTIndex] RETURNS [sei: ISEIndex] 
BEGIN 

matched: BOOLEAN; 
WITH (seb+type) SELECT FROM 
record ■> 
BEGIN 

[matched, sei] <- SearchCtxList[tag , TagContext[type]] ; 
IF matched THEN RETURN [sei]; 
END; 
ENDCASE; 
IF type # typeANY THEN ErrorDef s .errorhti[unknownVariant, tag]; 
RETURN [dataPtr.idANY] 
END; 

UnionField: PUBLIC PROCEDURE [rSei: recordCSEIndex] RETURNS [ISEIndex] » 
BEGIN 

sei, root, next: ISEIndex; 
ctx: CTXIndex = (seb+rSei) . f ieldctx; 
repeated: BOOLEAN; 
IF (ctxb+ctx) . ctxType « simple 
THEN 

FOR sei <- (ctxb+ctx). selist. next UNTIL sei = SENull 
DO 

next ^ NextSe[sei]; 
IF next = SENull THEN RETURN [sei]; 
ENDLOOP 
ELSE 
BEGIN 

repeated ♦- FALSE; 
DO 

sei <- root *- (ctxb+ctx) .sei ist; 
DO 

IF sei = SENull THEN EXIT; 

IF TypeForm[(seb+sei) . idtype] » union THEN RETURN [sei]; 
IF (sei ^ NextSe[sei]) = root THEN EXIT; 
ENDLOOP; 
IF repeated THEN EXIT; 

CopierDefs .CopyUnion[(seb+rSei) .f ieldctx]; repeated +• TRUE; 
ENDLOOP; 
END; 
RETURN [dataPtr.seAnon] 
END; 

VariantUnionType: PUBLIC PROCEDURE [type: SEIndex] RETURNS [CSEIndex] « 
BEGIN 

vType: CSEIndex = UnderType[type] ; 
RETURN [WITH (seb+vType) SELECT FROM 
record *> 
IF variant 

THEN ConsType[TypeForSe[UnionField[LOOPHOLE[vType. recordCSEIndex]]]] 
ELSE typeANY, 
ENDCASE -> typeANY] 
END; 

TagContext: PROCEDURE [type: CSEIndex] RETURNS [CTXIndex] - 
BEGIN 

subType: CSEIndex « VariantUnionType[type]; 
RETURN [WITH (seb+subType) SELECT FROM 
union «> casectx, 
ENDCASE »> CTXNull] 
END; 
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TypeForTree: PUBLIC PROCEDURE [t: TreeLink] RETURNS [SEIndex] - 
-- N.B. assumes t evaluated by TypeExp or Exp 
BEGIN 

RETURN [WITH t SELECT FROM 
symbol ■> index, 
subtree «> 

SELECT (tb+index) .name FROM 

cdot => TypeForTree[(tb+index) .son2], 
ENDCASE «> (tb+index). info. 
ENDCASE «> typeANY] 
END; 

TypeForSe: PROCEDURE [sei: ISEIndex] RETURNS [type: SEIndex] - 
BEGIN 

node: Treelndex; 
t* TreeLink* 

IF (seb+sei).mark3 THEN RETURN [(seb+sei) . idtype]; 
node ^ (seb+sei) . idvalue; 

IF (tb+node).name # dec! item THEN RETURN [typeTYPE]; 
t <- (tb+node).son2; 
type <r WITH t SELECT FROM 

hash => Resol veld[index, (seb+sei) .ctxnum], 

symbol => index, 

subtree => (tb+index) . info, 

ENDCASE => typeANY; 
RETURN 
END; 

ConsType: PROCEDURE [type: SEIndex] RETURNS [CSEIndex] « 
BEGIN 

sei, next: SEIndex; 
node: Treelndex; 
next +- type; 
DO 

sei ♦- next; 

WITH (seb+sei) SELECT FROM 
id => 
BEGIN 

IF ~CheckTypeId[LOOPHOLE[sei. ISEIndex]] 
THEN 
BEGIN 
IF sei ^ dataPtr.seAnon 

THEN ErrorDefs.errorsei[nonTypeId, LOOPHOLE[sei , ISEIndex]]; 
RETURN [typeANY] 
END; 
IF mark3 

THEN next ♦- idinfo 
ELSE 

BEGIN node ♦- idvalue; 

next <- Resol veTreeType[IF ( tb+node) . name = declitem 
THEN (tb+node). sons 
ELSE (tb+node) .son2, ctxnum]; 
END; 
END; 
constructor => RETURN [LOOPHOLE[sei . CSEIndex]]; 
ENDCASE; 
ENDLOOP; 
END; 

ResolveTreeType: PROCEDURE [t: TreeLink. ctx: CTXIndex] RETURNS [type: SEIndex] « 
BEGIN 

node: Treelndex; 
WITH t SELECT FROM 

hash => type ♦- Resol veld[index, ctx]; 
symbol «> type ♦■ index; 
subtree -> 

BEGIN node <- index; 
IF (tb+node). info # SENull 
THEN type ^ (tb+node) . info 
ELSE 

SELECT (tb+node). name FROM 
discrimTC »> 

WITH (tb+node). son2 SELECT FROM 
hash »> 

type <- SelectVariantType[ 
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ConsType[Resolv0TreeType[(tb+node) .sonl, ctx]], 
index]; 
ENDCASE »> ERROR; 
ENDCASE -> ERROR; 
END; 
ENDCASE -> ERROR; 
RETURN 
END; 

Bundling: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [nLevels: CARDINAL] - 
BEGIN 

ctx: CTXIndex; 
nLevels ^ 0; 
DO 

IF type » SENull THEN EXIT; 
WITH (seb+type) SELECT FROM 
record ■> 
BEGIN 

IF -unifield THEN EXIT; 
ctx ♦- fieldctx; 
WITH (ctxb+ctx) SELECT FROM 
included »> 
BEGIN 

IF privateFields AND ~(mdb+ctxmodule) .mdshared THEN EXIT; 
IF '-ctxcomplete 

THEN CompleteRecord[LOOPHOLE[type, recordCSEIndex]]; 
IF -ctxcomplete THEN EXIT; 
END; 
ENDCASE; 
IF CtxEntries[fieldctx] j^ 1 OR variant THEN EXIT; 
nLevels *- nLevels + 1; 

type <- Unbundle[LOOPHOLE[type, recordCSEIndex]]; 
END; 
ENDCASE => EXIT; 
ENDLOOP; 
RETURN 
END; 

Unbundle: PUBLIC PROCEDURE [record: recordCSEIndex] RETURNS [CSEIndex] » 
BEGIN OPEN (seb+record); 

RETURN [UnderType[(seb + (ctxb+f ieldctx) .sel ist) . idtype]] 
END; 

TargetType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [target: CSEIndex] « 
BEGIN 

target *- type; 
DO 
WITH (seb+target) SELECT FROM 

subrange => target ♦- UnderType[rangetype]; 
ENDCASE «> EXIT; 
ENDLOOP; 
RETURN [target] 
END; 

CanonicalType: PUBLIC PROCEDURE [sType: CSEIndex] RETURNS [type: CSEIndex] 
BEGIN 

type ♦- sType; 
DO 
WITH (seb+type) SELECT FROM 

subrange => type ♦- UnderType[rangetype]; 
record «> 

IF Bundling[type] ff 

THEN type ^ Unbundle[L0OPH0LE[type. recordCSEIndex]] 
ELSE RETURN; 
ENDCASE -> RETURN 
ENDLOOP; 
END; 

IdentifiedType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [BOOLEAN] ■ 
BEGIN 

WITH (seb+type) SELECT FROM 
mode «> RETURN [FALSE]; 
definition «> RETURN [FALSE]; 
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nil ■> RETURN [FALSE]; 
record ■> 
BEGIN 
IF variant AND '-comparable 

THEN [] ir UnionFielcl[LOOPHOLE[type. recordCSEIndex]]; 
RETURN [TRUE] 
END; 
ENDCASE -> RETURN [TRUE] 
END; 

OrderedType: PUBLIC PROCEDURE [type: SEIndex] RETURNS [BOOLEAN] - 
BEGIN 

sei: CSEIndex ^ ConsType[type]; 
DO 

WITH (seb+sei) SELECT FROM 
basic "> RETURN [ordered]; 
enumerated => RETURN [ordered]; 
pointer »> RETURN [ordered]; 
relative »> sei *- ConsType[of f setType] ; 
subrange »> sei ^ ConsType[rangetype]; 
long, real => sei <- ConsType[rangetype] ; 
ENDCASE => RETURN [FALSE]; 
ENDLOOP; 
END; 

MakeLongType: PUBLIC PROCEDURE [rType: SEIndex, hint: CSEIndex] RETURNS [type: CSEIndex] « 
BEGIN 

WITH (seb+hint) SELECT FROM 
long »> 

IF UnderType[rangetype] = UnderType[rType] THEN RETURN [hint]; 
ENDCASE; 
type ♦- makenonctxse[SIZE[long constructor SERecord]]; 
(seb+type)t ^ SERecord[mark3: TRUE, mark4: TRUE, 

sebody: constructor[long[rangetype: rType]]]; 
RETURN 
END; 

MakePointerType: PUBLIC PROCEDURE [cType: SEIndex, hint: CSEIndex] RETURNS [type: CSEIndex] 
BEGIN 

WITH (seb+hint) SELECT FROM 
pointer => 

IF -ordered AND UnderType[pointedtotype] = UnderType[cType] 
THEN RETURN [hint]; 
ENDCASE; 
type ^ makenonctxse[SIZE[pointer constructor SERecord]]; 
(seb+type)t 4- SERecord[ 
marks : TRUE, 
mark4: TRUE. 

sebody: constructor[pointer[ 
ordered: FALSE, 
readonly: FALSE, 
basing: FALSE, 
dereferenced: FALSE, 
pointedtotype: cType]]]; 
RETURN 
END; 

AllocFrameRecord: PROCEDURE [bti: CBTIndex. link: SEIndex] RETURNS [sei: recordCSEIndex] - 
BEGIN 

sei «- LOOPHOLE[makenonctxse[SIZE[l inked record constructor SERecord]]]; 
(seb+sei)t <- SERecord[ 
marks : TRUE, 
mark4: FALSE, 

sebody: constructor[record[ 
machineDep: FALSE, 
unifield: FALSE, 
argument: FALSE. 
defaultFields: FALSE, 
f ieldctx: (bb+bti) .localCtx, 
length: -- n*wordlength --, 
comparable: FALSE, 
privateFields: FALSE, 
lengthUsed: FALSE, 
monitored: (bb+bti ) .monitored, 
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variant: FALSE, 

linkpart: 1 inked[1 ink]]]]; 
RETURN 
END; 

MakeFrameRecord: PUBLIC PROCEDURE [t: TreeLink] RETURNS [rSei: CSEIndex] - 
BEGIN 

bti: CBTIndex « XferBodyCt]; 
IF bti # BTNull 
THEN 

rSei <- AnocFram0Record[bti , TransferTypes[(bb+bti) . ioType] . typein] 
ELSE 

BEGIN ErrorDefs.error[nonTypeCons]; rSei ♦- typeANY END; 
RETURN 
END; 

XferBody: PUBLIC PROCEDURE [t: TreeLink] RETURNS [bti: CBTIndex] ■ 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 
WITH t SELECT FROM 
symbol «> 

BEGIN sei ^ index; 
type *- UnderType[(seb+sei) . idtype]; 
bti <- WITH (seb+type) SELECT FROM 
transfer => 

IF ~(seb+sei) .constant 
THEN CBTNun 
ELSE 

SELECT mode FROM 
program «> 

IF (seb+sei) .mark4 
THEN (seb+sei) . idinfo 
ELSE dataPtr.mainBody, 
procedure =»> 

IF sei - (bb+dataPtr.bodylndex) . id 
THEN dataPtr.bodylndex 
ELSE CBTNull, 
ENDCASE «> CBTNun . 
ENDCASE => CBTNull; 
END; 
ENDCASE »> bti ♦- CBTNull; 
RETURN 
END; 

XferForFrame: PUBLIC PROCEDURE [ctx: CTXIndex] RETURNS [CSEIndex] « 
BEGIN 

bti: BTIndex; 

btLimit: BTIndex = LOOPHOLE[TableDef s, TableBounds[bodytype]. size]; 
bti ^ FIRST[BTIndex]; 
UNTIL bti = btLimit 
DO 

WITH entry: (bb+bti) SELECT FROM 
Callable »> 
BEGIN 

IF entry. localCtx = ctx THEN RETURN [UnderType[entry . ioType]] ; 
bti <- bti + (WITH entry SELECT FROM 

Inner => SIZE[Inner Callable BodyRecord], 
ENDCASE => SIZE[Outer Callable BodyRecord]); 
END; 
ENDCASE «> bti <- bti + SIZE[Other BodyRecord]; 
ENDLOOP; 
ERROR 
END; 

Interval: PUBLIC PROCEDURE [t: TreeLink, type: CSEIndex. constant: BOOLEAN] 
BEGIN 

node: Treelndex » GetNode[t]; 
BEGIN OPEN (tb+node); 
type ♦- TargetType[type]; 
sonl +- Rhs[sonl, type]; 
IF constant AND -RConstt] 

THEN ErrorDef s.errortree[nonConstant, sonl]; 
RPop[]; 
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son2 ^ Rhs[son2, type]; 
SELECT (seb+type).typetag FROM 

long -> BEGIN attrl ^ TRUE; attr2 ^ FALSE END; 

real «> attrl ♦- attr2 ♦- TRUE; 

ENDCASE -> attrl ^ attr2 <r FALSE; 
IF constant AND ~RConst[] 

THEN ErrorDefs.errortree[nonConstant, son2]; 
RPop[]; 
END; 
RETURN 
END; 

Sharing: PUBLIC TreeScan ■ 
BEGIN 

v: TreeLink ■ Exp[t, typeANY]; 
type: CSEIndex » RType[]; 
ctx: CTXIndex; 
sei: ISEIndex; 
ctx <- CTXNull; 
WITH (seb+type) SELECT FROM 
definition => ctx ♦- defCtx; 
transfer »> 

WITH V SELECT FROM 
symbol ■> 

BEGIN sei <- index; 

IF (seb+sei) .mark4 AND (seb+sei) . constant AND mode = program 

THEN ctx <- (bb+LOOPHOLE[(seb+sei).idinfo. CBTIndex]) . localCtx; 
END; 
ENDCASE; 
ENDCASE; 
IF ctx ff CTXNull 
THEN 

WITH (ctxb+ctx) SELECT FROM 

included => (mdb+ctxmodule) .mdshared <- TRUE; 
ENDCASE 
ELSE IF type # typeANY THEN ErrorDef s .errortree[typeCl ash, v]; 
RPop[]; RETURN 
END; 

END. 



